Overview e Motivazioni:

Per parlare di due argomenti a noi cari (il basket e la birra), abbiamo deciso di porci una domanda che ci permettesse di raggiungere il nostro scopo, ovvero “È possibile battere Stephen Curry ad una partita di Beer Pong?”. Utilizzando questa come espediente abbiamo cercato inoltre di individuare informazioni interessanti riguardanti i gusti di birre preferite negli stati americani ed il cambiamento del gioco del basket NBA negli ultimi anni.

L’analisi è stata condotta principalmente per essere descrittiva, senza l’utilizzo di modelli statistici complessi. Abbiamo posto l’attenzione sui grafici da utilizzare nel blog, facendo una selezione tra quelli inizialmente elaborati. Abbiamo inoltre utilizzato un algoritmo k-hierarchical per compiere una Cluster Analysis, ovvero una versione ibrida dei metodi K-means e dei gerarchici che utilizza le medie dei gruppi individuati gerarchicamente come centroidi del k-medie.

Abbiamo individuato:

un grande cambiamento nello stile di gioco delle squadre NBA, incentrato oggi sul tiro da 3 punti e sulle abilità dei giocatori di essere affidabili in questo fondamentale, contesto nel quale Stephen Curry risulta essere un giocatore ideale;
4 gruppi che ci permettessero di quantificare la “pesantezza” di alcune delle tipologie di birre vendute negli stati americani, individuando inoltre quelli in cui le preferenze ricadono su un gusto più amaro;
una birra che dovrebbe permetterci di raggiungere il nostro obiettivo;

Script:

Download delle librerie:

library("gapminder")
library("magick")
library("ggplot2")
library("ggrepel")
library("scales")
library("readr")
library("readxl")
library("tidyr")
library("dplyr")
library("grid")
library("tidyverse")  
library("cluster")    
library("factoextra")
library("plotly")
library("NbClust")

Importiamo i dati:

stats = read_csv("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/Seasons_Stats.csv", 
    col_types = cols(`3P` = col_integer(), 
        `3P%` = col_double(), `3PA` = col_integer(), 
        `3PAr` = col_number(), `AST%` = col_double(), 
        BLK = col_integer(), `BLK%` = col_double(), 
        BPM = col_number(), DBPM = col_number(), 
        DRB = col_integer(), `DRB%` = col_double(), 
        G = col_integer(), GS = col_integer(), 
        MP = col_number(), OBPM = col_number(), 
        ORB = col_integer(), `ORB%` = col_double(), 
        PER = col_number(), STL = col_integer(), 
        `STL%` = col_double(), TOV = col_integer(), 
        `TOV%` = col_double(), TRB = col_integer(), 
        `TRB%` = col_double(), `USG%` = col_double(), 
        VORP = col_number(), `WS/48` = col_number(), 
        blank2 = col_number(), blanl = col_double()))
playerdata=read_csv("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/player_data.csv")
players=read_csv("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/Players.csv")
beers=read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/beers.csv",";", escape_double = FALSE, trim_ws = TRUE)
breweries=read_csv("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/breweries.csv")

Importiamo anno 2017-2018, siccome non è presente nel dataset iniziale sistemiamo i missing values presenti, ponendoli uguali a 0:

nba = read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/nba.csv", 
    ";", escape_double = FALSE, trim_ws = TRUE)
nba2 = read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/nba2.csv", 
    ";", escape_double = FALSE, trim_ws = TRUE)

nba2=nba2[,c("Rk","Player","Pos","Age","Tm","PER","TS%","3PAr","FTr","ORB%","DRB%","TRB%","AST%","STL%","BLK%","TOV%","USG%","OWS","DWS","WS","WS/48","OBPM","DBPM","BPM","VORP")]
nba=cbind(nba[,-3],nba2[,6:25])
nba$Year=2018
nba=nba[,-1]

is_miss=is.na(nba)
nba[is_miss]=0
#posti uguali a 0 poichè gli NA corrsipondono a tale valore. Casi dei giocatori che non hanno fatto tiri ecc..

Consideriamo solamente gli anni dal 1990 in poi, siccome prima di questo periodo ci sono più missing values e meno informazioni a noi utili (ad esempio pochi tiri da 3 punti):

### DATA:

stats=stats[stats$Year >= 1990,]
stats=stats[,-c(1,22,27)]  #ci sono variabili vuote, le eliminiamo.
#dati=merge(stats,playerdata,by.x ="Player",by.y="name")

Trattamento dei missing values. Anche in questo caso gli NA corrispondono agli zeri:

# NA:

is_miss=is.na(stats)
stats[is_miss]=0
stats=stats[which(stats$Player!=0),]

is_miss=is.na(playerdata)
playerdata[is_miss]=0

Aggiungiamo la stagione 2018 al nostro dataset iniziale:

nba=nba[,c("Year","Player","Pos","Age","Tm","G","GS","MP","PER","TS%","3PAr","FTr","ORB%","DRB%","TRB%","AST%","STL%","BLK%","TOV%","USG%","OWS","DWS","WS","WS/48","OBPM","DBPM","BPM","VORP","FG","FGA","FG%","3P","3PA","3P%","2P","2PA","2P%","eFG%","FT","FTA","FT%","ORB","DRB","TRB","AST","STL","BLK","TOV","PF","PTS" )]

stats=rbind(stats,nba)

Rinominiamo le squadre che nel corso degli anni avevano cambiato nome, in modo tale da poterle considerare con i nomi attuali:

#BRK+NJN=BRK
#CHA+CHH+CHO=CHO
#NOH+NOK+NOP=NOP
#OKC+SEA=OKC
#MEM+VAN=MEM
#WAS+WSB=WAS

stats[which(stats$Tm=="NJN"),]$Tm="BRK"
stats[which(stats$Tm=="CHA"),]$Tm="CHO"
stats[which(stats$Tm=="CHH"),]$Tm="CHO"
stats[which(stats$Tm=="NOH"),]$Tm="NOP"
stats[which(stats$Tm=="NOK"),]$Tm="NOP"
stats[which(stats$Tm=="SEA"),]$Tm="OKC"
stats[which(stats$Tm=="VAN"),]$Tm="MEM"
stats[which(stats$Tm=="WSB"),]$Tm="WAS"

Togliamo la squadra Tot da stats, questa considera le statistiche totali dei giocatori che in una stagione hanno cambiato più squadre:

stats=stats[which(stats$Tm!="TOT"),]

Creiamo un nuovo dataset con le variabili che ci interessano:

## Tentativi da 2pt,3pt e ft per anno + leader:

#facciamo prima una funzione:

anni=as.numeric(names(table(stats$Year)))
peranno=function(anno) {
  datiprov=stats[which(stats$Year==anno),]
  f3p=sum(datiprov$`3P`)
  tot3p=sum(datiprov$`3PA`)
  f2p=sum(datiprov$`2P`)
  tot2p=sum(datiprov$`2PA`)
  ftp=sum(datiprov$`FT`)
  totft=sum(datiprov$`FTA`)
  leaderpt=datiprov[which.max(datiprov$PTS),]$Player
  leaderast=datiprov[which.max(datiprov$AST),]$Player
  leadertrb=datiprov[which.max(datiprov$TRB),]$Player
  leaderstl=datiprov[which.max(datiprov$STL),]$Player
  leaderblk=datiprov[which.max(datiprov$BLK),]$Player
  datiprov2=datiprov[which(datiprov$G > 40),]
  leaderws=datiprov2[which.max(datiprov2$WS),]$Player
  leaderper=datiprov2[which.max(datiprov2$PER),]$Player
  leaderbpm=datiprov2[which.max(datiprov2$BPM),]$Player
  matrix(c(anno,f2p,tot2p,round(f2p/tot2p,2),f3p,tot3p,round(f3p/tot3p,2),ftp,totft,round(ftp/totft,2),leaderpt,leaderast,leadertrb,leaderstl,leaderblk,leaderws,leaderper,leaderbpm),ncol=18,nrow =1)
}

#ciclo per creare il nostro dataset:

b=1
serie=matrix(0,nrow = 29,ncol = 18)
for(i in anni){
    serie[b,]=peranno(i)
    b=b+1
}

#aggiustiamo i dati:

serie=as.data.frame(serie)
names(serie)=c("anno","f2p","tot2pt","perc2p","f3p","tot3pt","perc3p","ftp","totft","percft","leaderpt","leaderast","leadertrb","leaderstl","leaderblk","leaderws","leaderper","leaderbpm")

for(i in 1:10){
    serie[,i]=as.numeric(as.character(serie[,i]))   #variabili numeriche
}   

#aggiungiamo i dati dei lockout, anni in cui si sono giocate meno partite:
serie$giocaxteam=rep(82,29)
serie[which(serie$anno==1999),]$giocaxteam=50
serie[which(serie$anno==2012),]$giocaxteam=66
serie$squadre=rep(30,29)

#aggiungiamo il numero di squadre per le stagioni in cui i team non erano 30:
serie[which(serie$anno==1990),]$squadre=27
serie[which(serie$anno==1991),]$squadre=27
serie[which(serie$anno==1992),]$squadre=27
serie[which(serie$anno==1993),]$squadre=27
serie[which(serie$anno==1994),]$squadre=27
serie[which(serie$anno==1995),]$squadre=27
serie[which(serie$anno==1996),]$squadre=29
serie[which(serie$anno==1997),]$squadre=29
serie[which(serie$anno==1998),]$squadre=29
serie[which(serie$anno==1999),]$squadre=29
serie[which(serie$anno==2000),]$squadre=29
serie[which(serie$anno==2001),]$squadre=29
serie[which(serie$anno==2002),]$squadre=29
serie[which(serie$anno==2003),]$squadre=29
serie[which(serie$anno==2004),]$squadre=29
serie$partiteanno=serie$giocaxteam*serie$squadre

#tre nuovi dataset:
tiriperanno=serie[,c(1:10,21)]
leaderperanno=serie[,c(1,11:18)]
partiteperteam=serie[,c(1,19)]

Grafici:

#grafico animato per studiare la relazione tra i tentativi da 3 punti e quelli da 2 punti, nel corso degli ultimi 30 anni


#aggiungiamo due nuove variabili:
stats$Tentativi.da.2.punti.per.partita=round(stats$`2PA`/stats$G,2)
stats$Tentativi.da.3.punti.per.partita=round(stats$`3PA`/stats$G,2)

#animazione:
img <- image_graph(800, 500, res = 96)

e=stats[which(stats$Year==1990),]
for(i in 1991:2018){
  prov=stats[which(stats$Year==i),]
  e=rbind(e,prov)
}
e=e[which(e$G > 30),]

datalist=split(e, e$Year)
out=lapply(datalist, function(data){
  p=ggplot(data, aes(x=data$'Tentativi.da.2.punti.per.partita', y= data$'Tentativi.da.3.punti.per.partita',col=Pos))+
    geom_point(size=3,alpha=0.70)+
    facet_wrap(~Pos)+
    ggtitle(data$Year)+
    theme_bw()+
    ylim(0,15)+
    xlim(0,25)+
    scale_color_discrete(name='ruoli')
  print(p+labs(x = "Tentativi da 2 punti per partita",y="Tentativi da 3 punti per partita"))
})
a=dev.off()
animation = image_animate(img, fps = 2)
v=print(animation)

## # A tibble: 29 x 7
##    format width height colorspace matte filesize density
##    <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
##  1 gif      800    500 sRGB       TRUE         0 72x72  
##  2 gif      800    500 sRGB       TRUE         0 72x72  
##  3 gif      800    500 sRGB       TRUE         0 72x72  
##  4 gif      800    500 sRGB       TRUE         0 72x72  
##  5 gif      800    500 sRGB       TRUE         0 72x72  
##  6 gif      800    500 sRGB       TRUE         0 72x72  
##  7 gif      800    500 sRGB       TRUE         0 72x72  
##  8 gif      800    500 sRGB       TRUE         0 72x72  
##  9 gif      800    500 sRGB       TRUE         0 72x72  
## 10 gif      800    500 sRGB       TRUE         0 72x72  
## # ... with 19 more rows

#grafico non utilizzato nel blog

#Grafico interattivo per valuate la medesima relazione, dividendo i giocatori per ruoli:

p=ggplot(stats, aes(x=Tentativi.da.2.punti.per.partita, y=Tentativi.da.3.punti.per.partita,color=Pos))+
    geom_point(aes(frame = Year),alpha=0.7,size=3)+
    ggtitle(stats$Year)+
    facet_wrap(~Pos)+
    ylim(0,15)+
    xlim(0,25)+
    theme_minimal()+
    scale_color_discrete(name='ruoli')+
    labs(x = "Tentativi da 2 punti per partita",y="Tentativi da 3 punti per partita")
v=ggplotly(p)

#Grafico non utilizzato nel blog

#come il precedente ma senza divisione per ruoli

p=ggplot(stats, aes(x=Tentativi.da.2.punti.per.partita, y=Tentativi.da.3.punti.per.partita,color=Pos))+
    geom_point(aes(frame = Year),alpha=0.6,size=4)+
    ggtitle(stats$Year)+
    theme_bw()+
    ylim(0,15)+
    xlim(0,25)+
    scale_color_discrete(name='ruoli')+
  labs(x = "Tentativi da 2 punti per partita",y="Tentativi da 3 punti per partita")
v=ggplotly(p)

#non utilizzato nel blog

#stessa cosa dei precedenti ma considerando solo alcuni anni in modo da rendere la visualizzazione più semplice:
datiprov=stats[which(stats$Year==1990),]
for (i in c(1994,1998,2002,2006,2010,2014,2018)) {
  e=stats[which(stats$Year==i),]
  datiprov=rbind(datiprov,e)
}



p=ggplot(datiprov, aes(x=Tentativi.da.2.punti.per.partita, y=Tentativi.da.3.punti.per.partita,color=Pos))+
    geom_point(aes(frame = Year),alpha=0.6,size=4)+
    ggtitle(stats$Year)+
    theme_bw()+
    ylim(0,15)+
    xlim(0,25)+
    scale_color_discrete(name='ruoli')+
  labs(x = "Tentativi da 2 punti per partita",y="Tentativi da 3 punti per partita")
v=ggplotly(p)

#grafico non utilizzato nel blog

#serie dei tentativi per le diverse tipologie di tiro

tiri.byyear=aggregate(cbind(Media.tentativi.3pt=round(tot3pt/partiteanno,2),Media.tentativi.2pt=round(tot2pt/partiteanno,2),Media.tentativi.Ft=round(totft/partiteanno,2),Somma.medie.tentativi.2pt.e.3pt=round((tot3pt/partiteanno+tot2pt/partiteanno),2)) ~ anno, data = tiriperanno,FUN = mean)
tiri2.byyear = gather(tiri.byyear,value = "value",key = "type",Media.tentativi.3pt,Media.tentativi.2pt,Media.tentativi.Ft,Somma.medie.tentativi.2pt.e.3pt)
a=ggplot(tiri2.byyear,aes(x=anno,y=value,color=type)) + 
  geom_line(size=2)+scale_color_manual(name = "",labels=c("Media 3pt","Media 2pt","Media tiri liberi","Media 3pt+2pt"),values = c("chocolate1","mediumvioletred","yellow2","yellowgreen"))
a=a+theme_bw()+ggtitle(label = "Serie storica delle medie dei tentativi")
v=ggplotly(a)

#non utilizzato nel blog

Creiamo un nuovo dataset, questa volta con dati per anno e squadra:

# Dati anno e squadra:

team=names(table(stats$Tm))   

perannoesquadra=function(anno,squadra) {
  datiprov=stats[which(stats$Year==anno),]
  datiprov=datiprov[which(datiprov$Tm==squadra),]
  f3p=sum(datiprov$`3P`)
  tot3p=sum(datiprov$`3PA`)
  f3perc=round(f3p/tot3p,2)
  f2p=sum(datiprov$`2P`)
  tot2p=sum(datiprov$`2PA`)
  f2perc=round(f2p/tot2p,2)
  fft=sum(datiprov$`FT`)
  totft=sum(datiprov$`FTA`)
  ftperc=round(fft/totft,2)
  leaderpt=datiprov[which.max(datiprov$PTS),]$Player
  leaderast=datiprov[which.max(datiprov$AST),]$Player
  leadertrb=datiprov[which.max(datiprov$TRB),]$Player
  leaderstl=datiprov[which.max(datiprov$STL),]$Player
  leaderblk=datiprov[which.max(datiprov$BLK),]$Player
  matrix(c(squadra,anno,f2p,tot2p,f2perc,f3p,tot3p,f3perc,fft,totft,ftperc,leaderpt,leaderast,leadertrb,leaderstl,leaderblk),ncol=16,nrow =1)
}

#ciclo:
b=1
serie2=matrix(0,nrow = 29*30,ncol = 16)
for(j in team){
  for(i in anni){
    serie2[b,]=perannoesquadra(anno=i,squadra=j)
    b=b+1 
  }
}

#aggiustiamo le variabili:
serie2=as.data.frame(serie2)
names(serie2)=c("squadra","anno","f2p","tot2p","f2perc","f3p","tot3p","f3perc","fft","totft","ftperc","leaderpt","leaderast","leadertrb","leaderstl","leaderblk")
serie2=serie2[which(serie2$f2perc!= "NaN"),]
serie2=serie2[which(serie2$squadra != "TOT"),]

# trasformazione numeri e caratteri
for(i in 2:16){
  if (i<12)  serie2[,i]=as.numeric(as.character(serie2[,i]))
  else serie2[,i]=as.character(serie2[,i])
}

#aggiungiamo partite per squadra
serie2=merge(serie2,partiteperteam,by="anno")

Grafici:

#Tentativi 3pt per squadre e anno:
a=ggplot(serie2,aes(x=squadra,y=tot3p,size=giocaxteam))+
  theme(legend.position="top",axis.text=element_text(size=6))+
  geom_point(aes(color=anno),alpha=0.70)+
  scale_color_gradient2(name="",breaks=c(1990,1998,2008,2017),labels=c("1990","1998","2008","2017"),low = "red",high = "blue", mid="yellow",midpoint=2003)+theme_minimal()
v=ggplotly(a)

#non utilizzato nel blog

serie2$Rapporto.3pt.2pt=round(serie2$tot3p/serie2$tot2p,2) #variabile rapporto tentativi 3pt/2pt
names(serie2)[17]="Partite.giocate" #rinominiamo la variabile per le partite giocate


a=ggplot(serie2,aes(x=squadra,y=Rapporto.3pt.2pt,size=Partite.giocate))+
  theme(legend.position="top",axis.text=element_text(size=6))+
  geom_point(aes(color=anno),alpha=0.70)+
  scale_color_gradient2(name="",breaks=c(1994,2004,2014),labels=c("1994","2004","2014"),low = "lightgreen",high = "lightsalmon2",mid="lightskyblue3",midpoint=2004)+
  theme_bw()+
  labs(x="Abbreviazione squadre",y="Rapporto tentativi 3pt/2pt")+
  ggtitle(label="Tentativi 3pt/2pt per squadra e anno")
v=ggplotly(a)

#grafico non utilizzato nel blog

#stesso grafico di prima ma animato:
a=ggplot(serie2,aes(x=squadra,y=Rapporto.3pt.2pt,size=Partite.giocate))+
  theme(legend.position="top",axis.text=element_text(size=6))+
  geom_point(aes(frame=anno),alpha=0.70)+
  theme_bw()+
  labs(x="Abbreviazione squadre",y="Rapporto tentativi 3pt/2pt")+scale_color_gradient2(name="",breaks=c(1994,2004,2014),labels=c("1994","2004","2014"),low = "lightgreen",high = "lightsalmon2",mid="lightskyblue3",midpoint=2004)+
  ggtitle(label="Tentativi 3pt/2pt per squadra e anno")
v=ggplotly(a)

mytext=paste("Anno = ", serie2$anno, "\n" , "Squadra= ", serie2$squadra, "\n", "3pt/2pt: ",serie2$Rapporto.3pt.2pt,"\n" , "Partite giocate= ", serie2$Partite.giocate,sep="")
v=style(p, text=mytext, hoverinfo = "text")

#grafico non utilizzato nel blog

#importiamo i nomi completi delle squadre NBA, in modo da aggregarle alle abbreviazioni
squadre_nba <- read_delim("StatisticalLearningProject/CLAMSES/Steph&Beer/squadre nba.csv", 
    ";", escape_double = FALSE, col_names = FALSE, 
    trim_ws = TRUE)
squadre_nba <- read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/squadre%20nba.csv",";", escape_double = FALSE, trim_ws = TRUE,col_names = F)
names(squadre_nba)=c("squadra","nome")

serie2=merge(serie2,squadre_nba,by="squadra")

serie2$Tentativi.medi.3pt=round(serie2$tot3p/serie2$Partite.giocate,2) #tentativi medi da tre punti per anno

#grafico interattivo delle serie storiche:
sd <- highlight_key(serie2, ~nome, "Scegli una squadra")
base <- plot_ly(sd, color =("black"), height = 400) %>%
  group_by(nome)
p2 <- base %>%
  add_lines(x = ~anno, y = ~Tentativi.medi.3pt, alpha = 0.8) %>%
  layout(xaxis = list(title = "Anno"),
         yaxis= list(title="Tentativi medi da tre punti per partita"))
subplot(p2, titleX = TRUE,titleY= TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = F, selectize = T)

Figura 1: Serie storiche dei tentativi da 3 punti per squadra. Un primo incremento negli anni dal ‘95 al ’97 è stato causato dall’avvicinamento della linea dei tre punti, poi tornata alla distanza di 7.25 metri a partire dal 98’

#di nuovo preso in considerazione il valore dato dal rapporto tentativi 3pt/2pt per squadra e anno
#grafico interattivo di prova:

sd <- highlight_key(serie2, ~anno, "Scegli un anno")
base <- plot_ly(sd, color =("black"), height = 400) %>%
  group_by(anno)
p1 <- base %>%
  add_bars(x = ~squadra, y = ~Rapporto.3pt.2pt, alpha = 0.5) %>%
  layout(xaxis = list(title = "Abbreviazione squadra"),yaxis = list(title = "3pt/2pt"))
r=subplot(p1, titleX = TRUE,titleY = TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = F, selectize = T,color = "red")


#grafico interattivo finale:
a=ggplot(serie2,aes(x=squadra,y=Rapporto.3pt.2pt,size=Partite.giocate))+
  theme(legend.position="top",axis.text=element_text(size=6))+
  geom_point(aes(color=anno),alpha=0.80,size=4)+
  scale_color_gradient2(name="",breaks=c(1994,2004,2014),labels=c("1994","2004","2014"),low = "lightgreen",high = "lightsalmon3",mid="lightskyblue3",midpoint=2004)+
  theme_minimal()+
  labs(x="Abbreviazione squadre",y="Rapporto tentativi 3pt/2pt")+
  ggtitle(label="Tentativi 3pt/2pt per squadra e anno")
ggplotly(a)

Figura 2: Rapporto tentativi 3pt/2pt per squadra e anno.

#grafico sulla relazione tenativi 3pt e 2pt

datiprov=stats[which(stats$Year==1990),]
for (i in c(1994,1998,2002,2006,2010,2014,2018)) {
  e=stats[which(stats$Year==i),]
  datiprov=rbind(datiprov,e)
}

p=ggplot(datiprov, aes(x=Tentativi.da.2.punti.per.partita, y=Tentativi.da.3.punti.per.partita,color=Pos))+
    geom_point(aes(frame = Year),alpha=0.7,size=3)+
    ggtitle(stats$Year)+
    facet_wrap(~Pos)+
    ylim(0,15)+
    xlim(0,25)+
    theme_minimal()+
    scale_color_discrete(name='ruoli')+
    labs(x = "Tentativi da 2 punti per partita",y="Tentativi da 3 punti per partita")
v=ggplotly(p,width = 500, height = 400)

#non utilizzato

#tentativi medi da tre punti per squadra negli ultimi trent'anni:
a=ggplot(serie2,aes(x=anno,y=Tentativi.medi.3pt,color=squadra))+geom_line()+theme_bw()+labs(y="Tentativi medi da tre punti")+ggtitle("Serie temporali tentativi medi da tre punti per squadra")+scale_color_discrete(name="Abbreviazione squadra")
v=ggplotly(a)

#grafico non utilizzato nel blog

#esempi grafici tentativi 2pt per squadre e anno:

#1
v=ggplot(serie2,aes(x=squadra,y=tot2p,size=Partite.giocate))+
  theme(legend.position="top",axis.text=element_text(size=6))+
  geom_point(aes(color=anno),alpha=0.70)+
  scale_color_gradient2(name="",breaks=c(1990,1998,2008,2017),labels=c("1990","1998","2008","2017"),low = "blue",high = "green", mid="yellow",midpoint=2003)

#2
v=ggplot(serie2,aes(x=anno,y=tot2p/Partite.giocate))+geom_line(aes(color=squadra))+theme_minimal()

#3
p=ggplot(serie2,aes(x=anno,y=tot2p/Partite.giocate))
p1=p+geom_line()+facet_wrap(~squadra)
theme_new=theme_bw() +theme(plot.background = element_rect(size = 1, color = "blue", fill = "white"),
        text=element_text(size = 12, family = "Serif", color = "black"),
        axis.text.y = element_text(colour = "black"),
        axis.text.x = element_text(colour = "black"),
        panel.background = element_rect(fill = "white"),
        strip.background = element_rect(fill = "yellow"))
v=p1+theme_new

Creiamo un nuovo dataset per anno e ruolo dei giocatori:

# Dati anno e ruolo:

ruoli=names(table(stats$Pos))   

perannoeruolo=function(anno,ruolo) {
  datiprov=stats[which(stats$Year==anno),]
  datiprov=datiprov[which(datiprov$Pos==ruolo),]
  minutigioc=sum(datiprov$MP)
  f3p=sum(datiprov$`3P`)
  tot3p=sum(datiprov$`3PA`)
  f3perc=round(f3p/tot3p,2)
  f2p=sum(datiprov$`2P`)
  tot2p=sum(datiprov$`2PA`)
  f2perc=round(f2p/tot2p,2)
  fft=sum(datiprov$`FT`)
  totft=sum(datiprov$`FTA`)
  ftperc=round(fft/totft,2)
  leaderpt=datiprov[which.max(datiprov$PTS),]$Player
  leaderast=datiprov[which.max(datiprov$AST),]$Player
  leadertrb=datiprov[which.max(datiprov$TRB),]$Player
  leaderstl=datiprov[which.max(datiprov$STL),]$Player
  leaderblk=datiprov[which.max(datiprov$BLK),]$Player
  matrix(c(ruolo,anno,minutigioc,f2p,tot2p,f2perc,f3p,tot3p,f3perc,fft,totft,ftperc,leaderpt,leaderast,leadertrb,leaderstl,leaderblk),ncol=17,nrow =1)
}
#ciclo:
b=1
serie3=matrix(0,nrow = 29*5,ncol = 17)
for(j in ruoli){
  for(i in anni){
    serie3[b,]=perannoeruolo(anno=i,ruolo=j)
    b=b+1 
  }
}
#dataset:
serie3=as.data.frame(serie3)
names(serie3)=c("ruolo","anno","minutigioc","f2p","tot2p","f2perc","f3p","tot3p","f3perc","fft","totft","ftperc","leaderpt","leaderast","leadertrb","leaderstl","leaderblk")

# trasformazione numeri e caratteri:
for(i in 2:17){
  if (i<13)  serie3[,i]=as.numeric(as.character(serie3[,i]))
  else serie3[,i]=as.character(serie3[,i])
}

### Tentativi 3pt per ruolo e anno

serie3$Tentativi.3pt.per.partita=round(round(serie3$tot3p/serie3$minutigioc,4)*48,4) #tentativi da 3pt per partita

#grafico tentativi da 3pt per partita e ruolo dei giocatori:
a=ggplot(serie3,aes(x=anno,y=Tentativi.3pt.per.partita,color=ruolo))+
  geom_line(size=1)+
  theme_bw()+
  labs(y="Tentativi da 3 punti ogni 48 minuti di gioco")+
  ggtitle("Serie temporale tentativi da 3 punti per ruolo")+
  scale_color_manual(values = c("lightgreen","lightsalmon2","lightskyblue3", "purple2","yellow2"))
v=ggplotly(a)

#grafico non utilizzato nel blog

#grafico a torta in movimento per le percentuali dei tentativi da 3 punti (per ruolo):

img <- image_graph(800, 500, res = 96)

e=serie3[which(serie3$anno==1990),]
e=e %>%  mutate(perc3p=tot3p/sum(tot3p)*100.0) %>%  arrange(desc(perc3p))
for(i in 1991:2018){
  prov=serie3[which(serie3$anno==i),]
  prov=prov %>%  mutate(perc3p=tot3p/sum(tot3p)*100.0) %>%  arrange(desc(perc3p))
  e=rbind(e,prov)
}

datalist=split(e, e$anno)

out=lapply(datalist, function(data){
  p=ggplot(data, aes(x="", y= perc3p, fill=ruolo))+
    geom_bar(width = 1, size = 1, color = "white", stat = "identity") +
    coord_polar("y") +
    geom_text(aes(label = paste0(round(perc3p), "%")),position = position_stack(vjust = 0.5)) +
    labs(x = NULL, y = NULL, fill = NULL,title = "3p percent") +
    guides(fill =guide_legend(reverse = TRUE)) +
    scale_fill_manual(values = c("green", "green3", "green4", "yellow3","yellow2")) +
    theme_minimal() +
    theme(axis.line = element_blank(),
          axis.text = element_blank(),
          axis.ticks = element_blank(),
          plot.title = element_text(hjust = 0.5, color = "black",size=30))+
    ggtitle(data$anno)
  print(p)
})
a=dev.off()
animation <- image_animate(img, fps = 2)
v=print(animation)

## # A tibble: 29 x 7
##    format width height colorspace matte filesize density
##    <chr>  <int>  <int> <chr>      <lgl>    <int> <chr>  
##  1 gif      800    500 sRGB       TRUE         0 72x72  
##  2 gif      800    500 sRGB       TRUE         0 72x72  
##  3 gif      800    500 sRGB       TRUE         0 72x72  
##  4 gif      800    500 sRGB       TRUE         0 72x72  
##  5 gif      800    500 sRGB       TRUE         0 72x72  
##  6 gif      800    500 sRGB       TRUE         0 72x72  
##  7 gif      800    500 sRGB       TRUE         0 72x72  
##  8 gif      800    500 sRGB       TRUE         0 72x72  
##  9 gif      800    500 sRGB       TRUE         0 72x72  
## 10 gif      800    500 sRGB       TRUE         0 72x72  
## # ... with 19 more rows

#grafico non utilizzato

#grafico interattivo per fare la stessa cosa del grafico a torta precedente:

e=serie3[which(serie3$anno==1990),]
e=e %>%  mutate(perc3p=tot3p/sum(tot3p)*100.0) %>%  arrange(desc(perc3p))
for(i in 1991:2018){
  prov=serie3[which(serie3$anno==i),]
  prov=prov %>%  mutate(perc3p=tot3p/sum(tot3p)*100.0) %>%  arrange(desc(perc3p))
  e=rbind(e,prov)
}


sd <- highlight_key(e, ~anno, "Scegli un anno")
base <- plot_ly(sd, color =("black"), height = 350) %>%
  group_by(anno)
p1 <- base %>%
  add_bars(x = ~perc3p, y =~ruolo , alpha = 0.7,marker=list( size=10 , opacity=0.7)) %>%
  layout(xaxis = list(title = "% tentativi da 3pt per partita"),yaxis = list(title = "Ruolo"))
subplot(p1, titleX = TRUE,titleY = TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = F, selectize = T,color = "red")

Figura 3: Percentuale dei tentativi da 3 punti sul totale per partita.

#prova grafico scatterpolar:
e=e[which(e$anno==2000),]
p <- plot_ly( type = 'scatterpolar',r = ~e$perc3p ,   theta = ~e$ruolo,   fill = 'toself'  ) %>%
  layout( polar = list( radialaxis = list(visible = T,range = c(0,40) )), showlegend = F)

Creiamo un nuovo dataset contenente le statistiche in carriera dei giocatori:

#Statistiche giocatori:

giocatori=names(table(stats$Player))
pergiocatore=function(giocatore) {
  datiprov=stats[which(stats$Player==giocatore),]
  RUOLO=names(table(datiprov$Pos))[which.max(table(datiprov$Pos))]
  STAGIONI=length(table(datiprov$Year))
  G=sum(datiprov$G)
  MPpg=round(sum(datiprov$MP)/sum(datiprov$G),2)
  FG=sum(datiprov$FG)
  FGA=sum(datiprov$FGA)
  FGperc=round(FG/FGA*100,2)
  TWOP=sum(datiprov$`2P`)
  TWOPA=sum(datiprov$`2PA`)
  TWOPperc=round(TWOP/TWOPA*100,2)
  THREEP=sum(datiprov$`3P`)
  THREEPA=sum(datiprov$`3PA`)
  THREEPperc=round(THREEP/THREEPA*100,2)
  FT=sum(datiprov$FT)
  FTA=sum(datiprov$FTA)
  FTperc=round(FT/FTA*100,2)
  ORB=sum(datiprov$ORB)
  DRB=sum(datiprov$DRB)
  TRB=sum(datiprov$TRB)
  AST=sum(datiprov$AST)
  STL=sum(datiprov$STL)
  BLK=sum(datiprov$BLK)
  TOV=sum(datiprov$TOV)
  PTS=sum(datiprov$PTS)
  ORBpg=round(ORB/G,2)
  DRBpg=round(DRB/G,2)
  TRBpg=round(TRB/G,2)
  ASTpg=round(AST/G,2)
  STLpg=round(STL/G,2)
  BLKpg=round(BLK/G,2)
  TOVpg=round(TOV/G,2)
  PTpg=round(PTS/G,2)
  OWS=round(mean(datiprov$OWS),2)
  DWS=round(mean(datiprov$DWS),2)
  WS=round(mean(datiprov$WS),2)
  PER=round(mean(datiprov$PER),2)
  OBPM=round(mean(datiprov$OBPM),2)
  DBPM=round(mean(datiprov$DBPM),2)
  BPM=round(mean(datiprov$BPM),2)
  matrix(c(giocatore,STAGIONI,RUOLO,G,MPpg,FGperc,TWOPperc,THREEP,THREEPA,THREEPperc,FTperc,ORBpg,DRBpg,TRBpg,ASTpg,STLpg,BLKpg,TOVpg,PTpg,
           OWS,DWS,WS,PER,OBPM,DBPM,BPM),ncol=26,nrow =1)
}

#ciclo
b=1
totgiocatori=matrix(0,nrow = 2414,ncol = 26)
for(i in giocatori){
    totgiocatori[b,]=pergiocatore(i)
    b=b+1
}

#dataset
totgiocatori=as.data.frame(totgiocatori)
names(totgiocatori)=c("GIOCATORE","STAGIONI","RUOLO","G","MPpg","FGperc","TWOPperc","THREEP","THREEPA","THREEPperc","FTperc","ORBpg","DRBpg","TRBpg","ASTpg","STLpg","BLKpg","TOVpg","PTpg","OWS","DWS","WS","PER","OBPM","DBPM","BPM")

#NaN e numerici
for(i in c(6,7,10,11)){
 totgiocatori[which(totgiocatori[,i]=="NaN"),][,i]=0 
}
for(i in 4:26){
  totgiocatori[,i]=as.numeric(as.character(totgiocatori[,i]))
}

Individuiamo Stephen Curry:

#dataset con statistiche in carriera 
dati=totgiocatori[,c(1,3,9,10,11)]
dati=dati[which(dati$THREEPA > 300),]  #selezioniamo i giocatori con più di 300 tentativi da 3pt in carriera
dati=dati[,-3]
dati$GIOCATORE=as.character(dati$GIOCATORE) #caratteri

#prova cluster k medie in tre gruppi:

fit=kmeans(scale(dati[,3:4]), 3, nstart = 25)
cluster=factor(fit$cluster)
dati=data.frame(dati,cluster)
levels(dati$cluster)=c("a","b","c")

a=ggplot(dati,aes(x=THREEPperc,y=FTperc))+
  geom_point(color=cluster,size=4,alpha=0.6)+theme_bw()+
  labs(x="% realizzazione da 3 punti",y="% realizzazione tiri liberi")+
  ggtitle("% tiri liberi - % tiri da 3 punti")+
  scale_color_manual(values = c("lightgreen","lightsalmon2","lightskyblue3"))

mytext=paste("Player = ", dati$GIOCATORE, "\n","3pt % = ", dati$THREEPperc, "\n", "Ft %: ",dati$FTperc, sep="")
p=plotly_build(a)
v=style(p, text=mytext, hoverinfo = "text",traces=c(1,2,3))

#non utilizzato nel blog

#grafico che identifica Curry nel nuovo dataset, in base alla percentuale ai tiri liberi e ai tre punti:

#grafico di prova interattivo:
library(crosstalk)
sd <- SharedData$new(dati, ~dati$GIOCATORE, group = "Scegli un giocatore")
p=plot_ly(sd,color ="orange", x = ~THREEPperc, y = ~FTperc,alpha=0.8,marker=list( size=13 , opacity=0.7),height = 400) %>%
  group_by(GIOCATORE) %>%hide_legend() %>%
  layout(xaxis = list(title = "Percentuale tiri da tre punti"), yaxis= list(title="Percentuale tiri liberi"))

r=subplot(p, titleX = TRUE,titleY= TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = F, selectize = T,color = "red")
  

#nuova variabile per classificare l'abilità al tiro:
dati$tiro=rep(3,702)
dati[which(dati$THREEPperc<=34 & dati$FTperc<=90),]$tiro=1
dati[which(dati$THREEPperc<=39 & dati$THREEPperc>34 & dati$FTperc<=95),]$tiro=2
dati[which(dati$THREEPperc<=40 & dati$FTperc<=70),]$tiro=1

#grafico finale non interattivo:
a=ggplot(dati,aes(x=THREEPperc,y=FTperc))+
  geom_point(aes(color=dati$RUOLO,size=factor(dati$tiro),alpha=0.4))+
  theme_minimal()+
  geom_text(x=44.8,y=92.3,label="Stephen Curry")+
  scale_size_manual(values=c(2,3,5))+
  labs(x="% realizzazione tiri da 3 punti",y="% realizzazione tiri liberi")

a + theme(legend.position="none")

Figura 4: Percentuale da tre punti e ai tiri liberi in carriera.

Analisi delle birre vendute in America:

names(breweries)[1]=c("brewery_id")
beer=merge(beers,breweries,by= "brewery_id") #uniamo il dataset delle birrerie con quello dei tipi di birre
beer=beer[,-c(1,2,5)] #eliminiamo le variabili superflue

#dataset per valutare la gradazione alcolica delle birre vendute:
b=1
stati=names(table(beer$state))
vuoto=matrix(0,nrow = length(stati),ncol = 3)
for (i in stati) {
  datiprov=beer[which(beer$state==i),]
  datiprov=datiprov[which(datiprov$abv != "NA"),]
  gradazione.alcolica.media=round(mean(datiprov$abv),3)
  nr.tipi.di.birre=length(names(table(datiprov$name.x)))
  vuoto[b,]=c(i,nr.tipi.di.birre,gradazione.alcolica.media)
  b=b+1
}

#importiamo il nome degli stati
stati <- read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/stati.csv", ";", 
    escape_double = FALSE, col_names = FALSE, 
    trim_ws = TRUE)
names(stati)=c("Nome.Stato","Stati")

#sistemaimo il dataset:
birre=as.data.frame(vuoto)
names(birre)=c("Stati","Tipi.di.birre","Gradazione.alcolica.media")
birre=merge(birre,stati,by="Stati")

#cartina americana per le gradazioni alcoliche medie delle birre vendute:
birre$hover <- with(birre, paste(Nome.Stato, '<br>',"Grad.alcolica.media", Gradazione.alcolica.media,'<br>', "Nr.tipi.birre", Tipi.di.birre))

l <- list(color = toRGB("grey"), width = 0.5)
g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa'),
  showlakes = TRUE,
  lakecolor = toRGB('white')
)

v=plot_geo(birre, locationmode = 'USA-states') %>%
  add_trace( z = ~birre$Gradazione.alcolica.media,text=birre$hover,
    locations = birre$Stati,marker = list(line = l)) %>%
  colorbar(title = "Tasso alcolico")%>%
layout(title = 'Tasso alcolico medio dei tipi di birre vendute per stato',geo = g )

#grafico non utilizzato

#importiamo manualmente dati mancanti
beer[1237,]$ibu=20
beer[1239,]$ibu=30
beer[1241,]$ibu=10
beer[1242,]$ibu=25
beer[1243,]$ibu=70

#eliminiamo gli NA presenti nel dataset, in quanto difficili da ricostruire:
beers1=beer[which(beer$ibu != "NA"),-c(6,7)]
beers1=na.omit(beers1)
beer=beers1

#beer1=beer
#rownames(beer) = make.names(beer$name.x, unique=TRUE)

#valutazione gruppi per cluster analysis:
my_data <- scale(beer[,1:2])
set.seed(123)
#res.nbclust <- NbClust(my_data, distance = "euclidean",min.nc = 2,method = "complete", index ="all")
#fviz_nbclust(res.nbclust) + theme_minimal()

#cluster:
df <- scale(beer[,1:2])
#facciamo un hierarchical k-means cluster
res.hk <-hkmeans(df, 4)
#visualizziamo l'albero:
v=fviz_dend(res.hk, cex = 0.6, palette = "jco", rect = TRUE, rect_border = "jco", rect_fill = TRUE)
#visualizziamo i cluster finali hkmeans:
a=fviz_cluster(res.hk, palette = "jco", repel = F, ggtheme = theme_classic())

#rinominiamo i gruppi individuati per identificare la pesantezza delle birre:
dati=data.frame(beer,res.hk$cluster)
names(dati)[7]=c("cluster")
dati$cluster=factor(dati$cluster)
levels(dati$cluster)=c("Poco alcolica e poco amara","Abbastanza alcolica e amara","Alcolica e amara","Abbastanza alcolica e poco amara")

#importiamo i nomi degli stati
stati <- read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/stati.csv", ";",     escape_double = FALSE, col_names = FALSE,     trim_ws = TRUE)
names(stati)=c("Nome.Stato","state")
dati=merge(dati,stati,by="state")


#grafico a tre dimensioni non utilizzato nel blog:
dati$hover <- with(dati, paste("Città:",dati$city, '<br>',"Nome:", dati$name.x,'<br>', "Tipo:", dati$style,'<br>', "Cluster:", dati$cluster))

v=plot_ly(dati, x = ~ounces, y = ~ibu, z = ~abv,text=dati$hover) %>%  add_markers(color = ~cluster)%>%  layout(scene = list(xaxis = list(title = 'Once'),yaxis = list(title = 'Grado amarezza'), zaxis = list(title = 'Tasso alcolico')))

#grafico a tre dimensioni interattivo non utilizzato nel blog:
library(crosstalk)
sd <- SharedData$new(dati, ~dati$state, group = "Scegli uno stato")
p=plot_ly(sd,  x = ~ounces, y = ~ibu, z = ~abv,text=dati$hover) %>% add_markers(color = ~cluster)%>%
  group_by(state) %>%hide_legend() %>%
  layout(xaxis = list(title = "Once"), yaxis= list(title="Grado amarezza"),zaxis = list(title = 'Tasso alcolico'), title="Birra")
v=subplot(p, titleX = TRUE,titleY= TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = TRUE, selectize = TRUE)

#grafico interattivo per tasso alcolico e grado di amarezza delle birre vendute negli stati americani (colorato per i gruppi della cluster analysis):

sd <- SharedData$new(dati, ~dati$Nome.Stato, group = "Scegli uno stato")
p=plot_ly(sd,  x = ~abv, y = ~ibu,text=dati$hover,height = 400) %>% add_markers(color = ~cluster,
        marker=list( size=14 , opacity=0.7),colors=c("lightgreen","lightsalmon2","lightskyblue3","plum3"))%>%
  group_by(dati$Nome.Stato) %>%hide_legend() %>%
  layout(xaxis = list(title = "Tasso alcolico",showline = FALSE, zeroline = FALSE), yaxis= list(title="Grado amarezza",showline = FALSE, zeroline = FALSE))
subplot(p, titleX = TRUE,titleY= TRUE, widths = c(1)) %>% 
  hide_legend() %>%
  highlight(on = "plotly_click", persistent = F,dynamic = F, selectize = T,color = NULL)

Figura 5: Suddivisione delle birre vendute in America in 4 macro gruppi per tasso alcolico e grado di amarezza.

#on = "plotly_click"

#riclassificazione amarezza delle birre in base all'indice ibu:
dati$amarezza=rep(0,1404)
dati[which(dati$ibu <= 30),]$amarezza="poco amara"
dati[which(dati$ibu > 30 & dati$ibu < 60),]$amarezza="amara"
dati[which(dati$ibu >= 60 ),]$amarezza="molto amara"
#table(dati$amarezza)
dati$amarezza=factor(dati$amarezza)

#dataset per calcolare i valori medi dell'ibu delle birre vendute per stato, con annesso il numero di tipi di birre vendute:
b=1
stati=names(table(dati$state))
vuoto=matrix(0,nrow = length(stati),ncol = 4)
for (i in stati) {
  datiprov=dati[which(dati$state==i),]
  ibu.medio=round(mean(datiprov$ibu),2)
  gusto.preferito=names(table(datiprov$amarezza))[which.max(table(datiprov$amarezza))] #tipo di birra più venduto
  nr.tipi.di.birre=length(names(table(datiprov$name.x))) #numero tipi di birre vendute per stato
  vuoto[b,]=c(i,ibu.medio,nr.tipi.di.birre,gusto.preferito)
  b=b+1
}

#importiamo ancora gli stati:
stati <- read_delim("https://raw.githubusercontent.com/cacio95/StatisticalLearningProject/master/data/stati.csv", ";",  escape_double = FALSE, col_names = FALSE,   trim_ws = TRUE)
names(stati)=c("Nome.Stato","Stati")

#dataset:
dati=as.data.frame(vuoto)
names(dati)=c("Stati","Ibu medio","Tipi.di.birre","Birra.preferita")
dati=merge(dati,stati,by="Stati")

#cartina per gli stati americani:

dati$hover <- with(dati, paste(Nome.Stato, '<br>',"Birra preferita:", dati$Birra.preferita,'<br>', "Nr.tipi.birre:", dati$Tipi.di.birre))

l <- list(color = toRGB("grey"), width = 0.5)
g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa'),
  showlakes = TRUE,
  lakecolor = toRGB('white'),
  showland = T,
  landcolor = toRGB("grey90")
)

plot_geo(dati, locationmode = 'USA-states') %>%
  add_trace( z = ~dati$`Ibu medio`,text=dati$hover,
    locations = dati$Stati,marker = list(line = l)) %>%
  colorbar(title = "Ibu")%>%
layout(title = 'Dove si preferiscono le birre più amare?',geo = g )

Figura 6: Media per stato dell’indice IBU di alcune delle tipologie di birre vendute.